home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / jan93cad.zip / TIP836.LSP < prev    next >
Lisp/Scheme  |  1993-02-12  |  831b  |  35 lines
  1. ;TIP836:  PERPL.LSP (c)1993, Bernd Hoffmann
  2.  
  3. (Defun C:PERPL (/ SA SB SNP OM OS PT1 PT2)
  4.   (setvar "cmdecho" 0)
  5.   (setq
  6.     SA  (getvar "snapang")
  7.     SB  (getvar "snapbase")
  8.     SNP (getvar "snapmode")
  9.     OM  (getvar "orthomode")
  10.     OS  (getvar "osmode")
  11.     PT1 (osnap (getpoint
  12.         "\nPick point on line to draw perpendicular from: "
  13.       )
  14.       "nea"
  15.     )
  16.   )
  17.   (setvar "osmode" 0)
  18.   (setq PT2 (osnap PT1 "end"))
  19.   (if (equal PT1 PT2)
  20.     (setq PT2 (osnap PT1 "MID"))
  21.   )
  22.   (command ".snap" "r" PT1 PT2)
  23.   (setvar "snapmode" 0)
  24.   (setvar "orthomodE" 1)
  25.   (prompt "\nto point:")
  26.   (command ".line" PT1 pause "")
  27.   (setvar "snapang" SA)
  28.   (setvar "snapbase" SB)
  29.   (setvar "snapmode" SNP)
  30.   (setvar "orthomode" OM)
  31.   (setvar "osmode" OS)
  32.   (setvar "cmdecho" 1)
  33.   (princ)
  34. ); end perpl.lsp
  35.